home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d5 / planetar.arc / MAP.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-05-08  |  29.4 KB  |  385 lines
  1. 1  'Copyright 1985 by Marilyn Davis
  2. 2  FDST= 0:FLAT=39.5333:FLON=124.383:FLAT$="39<UNK! {00F8}>32' North":FLON$="124<UNK! {00F8}>23' West":FUT$="17:00 11/26/1957":FSD#= 21.3568
  3. 3  FTI$="09:00":FCIT$="Los Angeles":FTDIF= 8:FD$=" 11/26/1957":FJD#= 2.43617E+06:FTAU= -0.420961:FO= 0:GOTO 30150
  4. 1030  ON ERROR GOTO 9000:LINE(82,20)-(235,33),1,B:LINE (160,38)-(160,146),1:LINE(40,146)-(290,146),1
  5. 1040  DEF SEG:POKE &H4E,3:LOCATE 4,12:PRINT"Key to the Sky Map":POKE &H4E,IC1
  6. 1050  LOCATE 7,2:PRINT"Stellar Magnitudes":LOCATE 7,25:PRINT"Other Objects":POKE &H4E,3:F1=1
  7. 1051  F1=F1+1:IF MID$(FLAT$,F1,1)=CHR$(248)THEN 1052 ELSE 1051
  8. 1052  LN1=LEN(FLAT$)-F1:FAP1$=LEFT$(FLAT$,F1-1):FAP2$=RIGHT$(FLAT$,LN1):FLAT1$=FAP1$+" "+FAP2$:F2=1:F3=LEN(FLON$)
  9. 1053  F2=F2+1:IF MID$(FLON$,F2,1)=CHR$(248)THEN 1054 ELSE IF F2<F3 THEN 1053 ELSE FLON1$=FLON$:GOTO 1055
  10. 1054  LN=LEN(FLON$)-F2:FOP1$=LEFT$(FLON$,F2-1):FOP2$=RIGHT$(FLON$,LN):FLON1$=FOP1$+" "+FOP2$
  11. 1055  DEF SEG:POKE &H4E,IC1:LOCATE 20,3:PRINT FLAT1$", "FLON1$:LOCATE 22,3:PRINT FD$ ", "FTI$" " FCIT$" time.":IX=(1+F1)*8:PUT(IX,152),DG%:IF FLON$<>FLON1$ THEN IX=8*(6+LN1+F2):PUT(IX,152),DG%:POKE &H4E,3 ELSE POKE &H4E,3
  12. 1060  PUT(2,65),N0%:LOCATE 9,3:PRINT"0.499 or brighter":PUT(169,62),SU%:LOCATE 9,24:PRINT "Sun":CIRCLE(243,67),2:LOCATE 9,33:PRINT "Moon":PSET(243,67),2
  13. 1070  PUT(2,81),N1%:LOCATE 11,3:PRINT"0.5 to 1.499":PUT(171,79),S1%:LOCATE 11,24:PRINT PL$(1)
  14. 1075  PUT(2,97),N2%:LOCATE 13,3:PRINT"1.5 to 2.499":PUT(171,95),S2%:LOCATE 13,24:PRINT PL$(2):PUT(242,95),S5%:LOCATE 13,33:PRINT PL$(5)
  15. 1080  PUT(3,114),N3%:LOCATE 15,3:PRINT"2.5 to 3.499":PUT(171,111),S4%:LOCATE 15,24:PRINT PL$(4):PUT(241,111),S6%:LOCATE 15,33:PRINT PL$(6):PUT(171,129),H%:LOCATE 17,24:PRINT PL$(7)
  16. 1090  PSET(5,132):LOCATE 17,3:PRINT"3.5 to 4.499":IF A$="K" THEN LOCATE 25,5:PRINT"Press ENTER to see the sky map.";:LOCATE 24,5:GOTO 5010 ELSE GOTO 30200
  17. 4000  ON ERROR GOTO 9000:SCREEN 0,1:CLS:COLOR IBW:LOCATE 3,8:PRINT"Press the ENTER key":LOCATE 5,8:PRINT"to see the sky map."
  18. 4010  LOCATE 7,8:COLOR IBR:PRINT"While the sky map is on":LOCATE 8,8:PRINT"the screen, you may"
  19. 4020  LOCATE 11,8:COLOR IBW:PRINT"press
  20. 4030  LOCATE 13,8:COLOR IBW:PRINT"I ";:COLOR IBR:PRINT"to ";:COLOR IBW:PRINT"I";:COLOR IBR:PRINT"dentify an object.
  21. 4040  LOCATE 14,8:COLOR IBW:PRINT"C ";:COLOR IBR:PRINT"to locate a ";:COLOR IBW:PRINT"C";:COLOR IBR:PRINT"onstellation.
  22. 4045  LOCATE 15,8:COLOR IBW:PRINT"S ";:COLOR IBR:PRINT"for ";:COLOR IBW:PRINT"S";:COLOR IBR:PRINT"olar system objects.
  23. 4050  LOCATE 16,8:COLOR IBW:PRINT"P ";:COLOR IBR:PRINT"to ";:COLOR IBW:PRINT"P";:COLOR IBR:PRINT"rint the sky map.":LOCATE 17,8:COLOR IBW:PRINT"L ";:COLOR IBR:PRINT"to ";:COLOR IBW:PRINT"L";:COLOR IBR:PRINT"ocate an object."
  24. 4060  LOCATE 18,8:COLOR IBW:PRINT"K ";:COLOR IBR:PRINT"to see the ";:COLOR IBW:PRINT"K";:COLOR IBR:PRINT"ey.
  25. 4065  COLOR IBW:LOCATE 19,8:PRINT"M ";:COLOR IBR:PRINT"to see this ";:COLOR IBW:PRINT"M";:COLOR IBR:PRINT"enu.
  26. 4066  LOCATE 20,8:COLOR IBW:PRINT"T ";:COLOR IBR:PRINT"for ";:COLOR IBW:PRINT"T";:COLOR IBR:PRINT"echnical options.
  27. 4070  LOCATE 23,8:PRINT"Press the ESC key to":LOCATE 24,8:PRINT"start over or to stop.";:IF IDONE=1 THEN MESS=1
  28. 4075  GOTO 5010
  29. 4080  CLS:SCREEN 0,1:COLOR IBR:LOCATE 10,5:PRINT"Press:":LOCATE 12,5:COLOR IBW:PRINT"Esc";:COLOR IBR:PRINT" to quit"
  30. 4081  A$=INKEY$:IF A$<>""THEN 4081
  31. 4082  LOCATE 14,5:COLOR IBW:PRINT"M";:COLOR IBR:PRINT" to return to the";:COLOR IBW:PRINT" M";:COLOR IBR:PRINT"enu
  32. 4084  LOCATE 16,5:COLOR IBW:PRINT"A";:COLOR IBR:PRINT" to start";:COLOR IBW:PRINT" A";:COLOR IBR:PRINT"gain.":LOCATE 20,5
  33. 4086  A$=INKEY$:IF A$=""THEN 4086 ELSE IF A$=CHR$(27) THEN SYSTEM ELSE IF A$="M" OR A$="m"THEN CLS:MESS=1:GOTO 4000 ELSE IF A$="a" OR A$="A" THEN CLS:LOCATE 15,14:PRINT"Please wait...":CLOSE#1:CHAIN"front",1:ELSE GOTO 4086
  34. 4990  LOCATE 1,1:PRINT STRING$(14,32);:IWH=0
  35. 5000  DRAW"b m 5,141 c3;f2 h1e1g2 bm 5,149 e1 f1 g1 h1 bm 5,157 e1 f1 g1 h1 r1 bm 6,165 r1 d1 l1":PSET (6,173),3:IF FI<>0 THEN DEF SEG:POKE &H4E,3:CIRCLE(6,195),2,3:PSET(6,195),IC2:LOCATE 25,3:PRINT USING"###% full";FI;:LOCATE 1,1
  36. 5005  DEF SEG:POKE &H4E,IC2:LOCATE 17,39:PRINT"I";:LOCATE 18,39:PRINT"C";:LOCATE 19,39:PRINT "S";:LOCATE 20,39:PRINT"P";:LOCATE 21,39:PRINT"L";:LOCATE 22,39:PRINT"K";:LOCATE 23,39:PRINT "M";:LOCATE 24,39:PRINT"T";:LOCATE 22,6
  37. 5007  IF IR=0 THEN GOSUB 29999 ELSE IR=0
  38. 5010  KL=KL+1:IF KL>10 THEN 5011 ELSE IF K$(KL)=""THEN 5011 ELSE A$=K$(KL):K$(KL)="":GOTO 5012
  39. 5011  A$=INKEY$:IF A$=""THEN 5011
  40. 5012  IF A$=CHR$(27) THEN 4080
  41. 5013  IF A$="T" OR A$="t" THEN 5500
  42. 5015  IF A$="P" OR A$="p" THEN 5200 ELSE IF A$="L"OR A$="l"THEN 5050
  43. 5016  IF A$="S" OR A$="s" THEN 5100
  44. 5020  IF A$="C" OR A$="c" THEN 7000
  45. 5025  IF A$="I" OR A$="i"THEN 8000
  46. 5027  IF A$="K" OR A$="k" THEN A$="K":CLS:SCREEN 1,0:GOTO 1030
  47. 5028  IF A$="M" OR A$="m" THEN 4000
  48. 5029  IF A$=CHR$(13) THEN 6000
  49. 5030  GOTO 5010
  50. 5050  IF IDOP=1 THEN 31000 ELSE GET#1,1:IDOP=1:IPRIN=0:LOCATE 1,1:PRINT"Please wait...":CHAIN MERGE"planmerge",31000,ALL,DELETE 30150-40000
  51. 5100  IF IDONE=0 THEN ICR=1:GOSUB 6000 ELSE IF MESS=1 THEN CLS:GOSUB 30000
  52. 5110  IF IPL=1 THEN 4990 ELSE IF IDOP=1 THEN GOTO 30150 ELSE GET#1,1:IDOP=1:LOCATE 1,1:IPRIN=0:PRINT"Please wait...":CHAIN MERGE"planmerge",30150,ALL,DELETE 30150-40000
  53. 5200  IF IDONE=0 THEN ICR=1:GOSUB 6000
  54. 5201  SCREEN 0,1:CLS:WIDTH 40:LOCATE 10,12:COLOR IBR:PRINT"Please wait.":LOCATE 13,12:PRINT"Printing the sky map":LOCATE 15,12:PRINT"takes a while.":A$=INKEY$:IF A$=CHR$(27) THEN 4000
  55. 5203  IF IPRIN=0 THEN GET#1,1:IPRIN=1:IDOP=0:CHAIN MERGE"printer",30210,ALL,DELETE 30150-40000:ELSE GOTO 30210
  56. 5500  CLS:WIDTH 40:SCREEN 0,1
  57. 5550  LOCATE 1,12:COLOR IYL:PRINT"Technical Options":COLOR IBR:LOCATE 3,5:PRINT"The uncorrected stars' positions":PRINT"are given for the year 2000.0.  For":PRINT"other years, ";:COLOR IYL:PRINT"correct the position for:
  58. 5555  LOCATE 8,4:COLOR IBW:PRINT OP$(0);:COLOR IYL:PRINT" proper motion ";:COLOR IBR:PRINT CHR$(218)" Each correction
  59. 5560  LOCATE 9,4:COLOR IBW:PRINT OP$(1);:COLOR IYL:PRINT" precession    ";:COLOR IBR:PRINT CHR$(179)" makes the
  60. 5565  LOCATE 10,4:COLOR IBW:PRINT OP$(2);:COLOR IYL:PRINT" nutation      ";:COLOR IBR:PRINT CHR$(179)" program
  61. 5570  LOCATE 11,4:COLOR IBW:PRINT OP$(3);:COLOR IYL:PRINT" aberration    ";:COLOR IBR:PRINT CHR$(192)" slower.":LOCATE 12,3:COLOR IYL:PRINT STRING$(36,46);
  62. 5575  COLOR IBR:LOCATE 14,22:PRINT"On the sky map,":LOCATE 15,22:PRINT"include stars with:":LOCATE 17,22:COLOR IYL:PRINT"Magnitude < ";:COLOR IBW:PRINT OP$(4);:LOCATE 19,22:COLOR IBR:PRINT"(4.5, 3.5, or 2.5)
  63. 5580  LOCATE 14,2:PRINT"Use these":LOCATE 15,2:COLOR IYL:PRINT"aspect ratios";:COLOR IBR:PRINT":":LOCATE 16,2:PRINT"(vertical axis/":LOCATE 17,2:PRINT"horizontal axis)
  64. 5585  LOCATE 19,2:COLOR IYL:PRINT"Screen = ";:COLOR IBW:PRINT OP$(5) OP$(6);:COLOR IBR:PRINT"/";:COLOR IBW:PRINT OP$(7) OP$(8)
  65. 5590  LOCATE 20,2:COLOR IYL:PRINT"Printer= ";:COLOR IBW:PRINT OP$(9) OP$(10);:COLOR IBR:PRINT"/";:COLOR IBW:PRINT OP$(11)OP$(12):COLOR IYL:FOR N=13 TO 21:LOCATE N,20:PRINT".";:NEXT N:LOCATE 22,3:PRINT STRING$(36,46)
  66. 5610  LOCATE 24,15:COLOR IBR:PRINT"Press the ";:COLOR IYL:PRINT"ENTER";:COLOR IBR:PRINT" key";:LOCATE 25,15:PRINT"when you are finished.";:K=0:IBL=IYL+8:GOTO 5640
  67. 5635  PRINT OP$(K):K=(K+1) MOD 13
  68. 5640  IY=VAL(LEFT$(OPP$(K),2)):IX=VAL(RIGHT$(OPP$(K),2)):LOCATE IY,IX:COLOR IBL:PRINT OP$(K):COLOR IBW:LOCATE IY,IX
  69. 5650  A$=INKEY$:IF A$=""THEN 5650
  70. 5660  IF A$=CHR$(27) THEN 4000
  71. 5665  IF A$=CHR$(13) THEN 5800
  72. 5670  IF LEN(A$)=2 THEN BA$=RIGHT$(A$,1) ELSE BA$="A"
  73. 5680  IF BA$=CHR$(77) THEN 5635
  74. 5690  IF BA$=CHR$(75) THEN PRINT OP$(K):K=(K+12) MOD 13:GOTO 5640
  75. 5700  IF BA$=CHR$(72) THEN PRINT OP$(K):IF K=0 THEN K=9:GOTO 5640 ELSE IF K<6 THEN K=(K+12)MOD 13:GOTO 5640 ELSE IF K<9 THEN K=4:GOTO 5640 ELSE K=K-4:GOTO 5640
  76. 5710  IF BA$=CHR$(80) THEN PRINT OP$(K):IF K>8 THEN K=0:GOTO 5640 ELSE IF K>4 THEN K=K+4:GOTO 5640 ELSE K=(K+1)MOD 13:GOTO 5640
  77. 5720  IF A$=CHR$(8) THEN PRINT OP$(K):K=(K+12)MOD 13:GOTO 5640
  78. 5730  IF(A$="Y" OR A$="y")AND K<4 THEN OP$(K)="Yes":GOTO 5635
  79. 5740  IF (A$="N" OR A$="n") AND K<4 THEN OP$(K)="No ":GOTO 5635
  80. 5750  IF K=4 AND(A$="4" OR A$="3" OR A$="2") THEN OP$(K)=A$+".5":GOTO 5635
  81. 5760  IF K>4 AND A$<CHR$(58) AND A$>CHR$(47) THEN OP$(K)=A$:GOTO 5635
  82. 5770  GOTO 5650
  83. 5800  ULN=(VAL(OP$(11)+OP$(12)))/(VAL(OP$(9)+OP$(10))):IF ULN>1.45 THEN LOCATE 22,1:COLOR IBW:PRINT"Invalid printer ratio--Please try again":K=9:GOTO 5640
  84. 5810  SCRN=(VAL(OP$(7)+OP$(8)))/(VAL(OP$(5)+OP$(6))):IF SCRN>1.45 THEN LOCATE 22,1:COLOR IBW:PRINT"Invalid screen ratio.":LOCATE 23,1:PRINT"Please try again.":K=5:GOTO 5640
  85. 5820  CLS:GM=VAL(OP$(4))-0.000999999:IDD=1:IF GM<>TOPM OR SCR<>SCRN THEN IDD=0
  86. 5822  TOPM=GM:SCR=SCRN:UL=ULN:IO=0:IF OP$(0)="Yes"THEN IO=1
  87. 5824  IF IO<>IPROP THEN IDD=0:IPROP=IO
  88. 5826  IO=2:IF OP$(1)="Yes"THEN IO=1
  89. 5828  IF IO<>IPREC THEN IDD=0:IPREC=IO
  90. 5830  IO=0:IF OP$(2)="Yes"THEN IO=1
  91. 5832  IF IO<>IABER THEN IDD=0:IABER=IO
  92. 5834  IO=0:IF OP$(3)="Yes"THEN IO=1
  93. 5836  IF IO<>INUT THEN IDD=0:INUT=IO
  94. 5837  IF IESC=1 THEN IF IDD=1 THEN 5999 ELSE ERASE KX,KY,KM:CLOSE#3:IESC=0
  95. 5840  IDONE=IDD*IDONE:IF IDONE=0 THEN ERASE ACT:DIM ACT(58,32):IF IPL=1 THEN IPL=0:ERASE PL:GOTO 6000 ELSE GOTO 6000 ELSE GOSUB 30000:GOTO 5000
  96. 5999  GOSUB 30000:GOSUB 29999:IESC=0:GOTO 6004
  97. 6000  IF IDONE=1 THEN GOSUB 30000:GOTO 4990 ELSE IF IESC=1 THEN 5999 ELSE DIM KM(60),KX(60),KY(60):IWH=6:SCREEN 1,0:CLS:ULY=2:DPX=SCR*DPP:IMORE=INUT+IABER:COLOR 0,1:SB=0:NS=0:MN=0:LLC=3:LC=3:N=0:KL=-1:KC=0:GOSUB 29999
  98. 6001  OPEN "conames"FOR INPUT AS #3:FOR I=0 TO 10:K$(I)="":NEXT I:KI=0:ISTOP=0:IK=0:MN=0:GOTO 6004
  99. 6002  KY(KC)=-5
  100. 6003  KC=KC+1:NS=NS+1:J=JY\8:ACT(J,0)=ACT(J,0)+1:ACT(J,ACT(J,0))=N
  101. 6004  A$=INKEY$:IF A$=CHR$(27) THEN IESC=1:FOR I=0 TO KI:K$(I)="":NEXT I:KI=0:GOTO 6440 ELSE IF A$<>""THEN K$(KI)=A$:KI=KI+1:IF KI=11 THEN KI=10
  102. 6005  N=N+1:GET#1,N:IF ASC(MID$(MAG$,3,1))=0 THEN ISTOP=1:IT=0:IK=0:GOTO 6014 ELSE IB=CVS(B$):IF BINS(IB)=0 THEN 6004
  103. 6006  GM=VAL(MAG$):IF GM>TOPM THEN 6004 ELSE RA=VAL(RA1$)+VAL(RA2$)/60+VAL(RA3$)/3600:DEC=VAL(D1$)+VAL(D2$)/60+VAL(D3$)/3600:IF SD$="-"THEN DEC=-DEC
  104. 6008  KM(KC)=INT(GM+0.5):IF IPROP=1 THEN RA=RA+(VAL(PMR$)*YDI)/54000:DEC=DEC+(VAL(PMD$)*YDI)/3600
  105. 6010  ON IPREC GOSUB 19900,20000:IF Z=0 THEN 6004
  106. 6012  IF CON$="    " OR CONS$(MN)=CON$ THEN 6070 ELSE MN=MN+1:CONS$(MN)=CON$:AC(MN)=N:IT=0:IK=0:IF KC=0 THEN CONS$(MN-1)="    ":GOTO 6044
  107. 6014  IF KY(IK)=-5 THEN 6024 ELSE IT=IT+1:IF KM(IK)=4 THEN PUT(KX(IK),KY(IK)),R4%,XOR:GOTO 6024
  108. 6016  IF KM(IK)=3 THEN PUT(KX(IK),KY(IK)),R3%,XOR:GOTO 6024
  109. 6018  IF KM(IK)=2 THEN PUT(KX(IK),KY(IK)),R2%,XOR:GOTO 6024
  110. 6020  IF KM(IK)=1 THEN PUT(KX(IK),KY(IK)),R1%,XOR:GOTO 6024
  111. 6022  IF KM(IK)<=0 THEN PUT(KX(IK),KY(IK)),R0%,XOR
  112. 6024  IK=IK+1:IF IK<KC THEN 6014 ELSE IK=0:IF IT=0 THEN MN=MN-1:IF ISTOP<>1 THEN CONS$(MN)=CON$
  113. 6026  IF KY(IK)=-5 THEN 6032 ELSE IF KM(IK)=4 THEN PUT(KX(IK),KY(IK)),N4%,OR:GOTO 6032
  114. 6027  IF KM(IK)=3 THEN PUT(KX(IK),KY(IK)),N3%,OR:GOTO 6032
  115. 6028  IF KM(IK)=2 THEN PUT(KX(IK),KY(IK)),N2%,OR:GOTO 6032
  116. 6029  IF KM(IK)=1 THEN PUT(KX(IK),KY(IK)),N1%,OR:GOTO 6032
  117. 6030  IF KM(IK)<=0 THEN PUT(KX(IK),KY(IK)),N0%,OR:GOTO 6032
  118. 6032  IK=IK+1:IF IK<KC THEN 6026 ELSE IF ISTOP=1 THEN 6425 ELSE KC=0:KM(0)=INT(GM+0.5)
  119. 6044  INPUT#3,NA$:INPUT#3,NB$:NA$=NA$+" ":IF EOF(3)THEN CLOSE#3:OPEN"conames"FOR INPUT AS #3
  120. 6045  IF NA$<>CONS$(MN) THEN 6044 ELSE WHCON$(MN)=NB$:POKE &H4E,IC2:LN=LEN(NB$):IF LN<12 THEN LOCATE 2,1:PRINT STRING$(12,32):LOCATE 1,1:GOTO 6050 ELSE LOCATE 1,1:NN=2
  121. 6047  NN=NN+1:IF ASC(MID$(WHCON$(MN),NN,1))>96 THEN IF NN<12 THEN 6047 ELSE NB$=LEFT$(NB$,11)+".":LOCATE 2,1:PRINT STRING$(12,32):LOCATE 1,1:GOTO 6050
  122. 6048  NN=NN-1:NA$=LEFT$(NB$,NN):NB$=RIGHT$(NB$,LN-NN):LN=12-LEN(NA$):PRINT NA$+STRING$(LN,32)
  123. 6050  LN=12-LEN(NB$):PRINT NB$+STRING$(LN,32)
  124. 6070  IF KM(KC)=4 THEN JY=INT(ULY*Y+22.5):IF Y<0.5 OR Y>196 THEN 6002 ELSE KY(KC)=INT(Y-0.5):KX(KC)=INT(X-0.5):PUT(KX(KC),KY(KC)),R4%,XOR:GOTO 6003
  125. 6075  IF KM(KC)=3 THEN JY=INT(ULY*Y+22):IF Y<1 OR Y>196 THEN 6002 ELSE KX(KC)=INT(X-1):KY(KC)=INT(Y-1):PUT(KX(KC),KY(KC)),R3%,XOR:GOTO 6003
  126. 6080  JY=INT(ULY*Y+21.5):IF Y<1.5 OR Y>196 THEN 6002 ELSE KX(KC)=INT(X-1.5):KY(KC)=INT(Y-1.5):IF KM(KC)=2 THEN PUT(KX(KC),KY(KC)),R2%,XOR:GOTO 6003
  127. 6090  IF KM(KC)=1 THEN PUT(KX(KC),KY(KC)),R1%,XOR:GOTO 6003
  128. 6100  IF KM(KC)<=0 THEN PUT(KX(KC),KY(KC)),R0%,XOR:GOTO 6003
  129. 6425  ERASE KM,KX,KY:CLOSE#3
  130. 6440  GET(48,49)-(59,149),P1%
  131. 6450  GET(60,21)-(79,177),P2%
  132. 6460  GET(80,0)-(239,199),P3%
  133. 6470  GET(240,21)-(259,177),P4%
  134. 6480  GET(260,49)-(271,149),P5%:IF IESC=1 THEN ICR=0:GOTO 4000
  135. 6490  MESS=0:IDONE=1:IF ICR=1 THEN ICR=0:RETURN ELSE GOTO 4990
  136. 7000  KXY=0:IF IDONE=0 THEN ICR=1:GOSUB 6000
  137. 7001  CLS:SCREEN 0:COLOR 7:LOCATE 1,1:PRINT"Here is a list of the visible":PRINT "constellations.  Which constellation":PRINT"would you like to see?  Please type the":PRINT"three letter abbreviation.":N=0:MMO=0:K=5:IS=1:N2=6
  138. 7005  IF KXY=1 THEN LOCATE 5,1:COLOR 15:PRINT CO$"is not listed. Please try again.   ";:LOCATE 4,28:DEF SEG:POKE &H4E,7
  139. 7010  N=N+1:IF CONS$(N)="    "THEN 7010
  140. 7015  K=K+1:IF K>22 THEN IF IS=1 THEN IS=20:K=6:ELSE LOCATE 24,1:PRINT"Press the ENTER key for more.";:MMO=1:LOCATE 4,28:GOTO 7070
  141. 7020  LOCATE K,IS:L=LEN(WHCON$(N)):IF K=22 AND L>14 THEN A$=LEFT$(WHCON$(N),14):PRINT CONS$(N) A$;:GOTO 7035
  142. 7025  IF L>14 THEN PRINT CONS$(N):K=K+1:LOCATE K,IS+1:PRINT WHCON$(N); ELSE PRINT CONS$(N) WHCON$(N);
  143. 7035  IF N<MN THEN 7010 ELSE LOCATE 24,1:PRINT STRING$(39,32);:MMO=0:LOCATE 4,28:GOTO 7070
  144. 7040  FOR I=6 TO 23:LOCATE I,1:PRINT STRING$(39,32);:NEXT I:K=5:IS=1:GOTO 7015
  145. 7070  A$=INKEY$:IF A$=""THEN 7070 ELSE IF A$=CHR$(13) AND MMO=1  THEN 7040 ELSE A=ASC(A$):IF A<123 AND A>96 THEN A=A-32:A$=CHR$(A) ELSE IF A$=CHR$(27) THEN 7299 ELSE IF A<65 OR A>90 THEN 7070
  146. 7080  PRINT A$;:LOCATE 5,1:PRINT STRING$(39,32):LOCATE 4,29
  147. 7090  D$=INKEY$:IF D$=""THEN 7090 ELSE B=ASC(D$):IF B=8 THEN LOCATE 4,28:PRINT" ";:LOCATE 4,28:GOTO 7070 ELSE IF B<123 AND B>96 THEN B=B-32:D$=CHR$(B) ELSE IF D$=CHR$(27) THEN GOTO 7299 ELSE IF B<65 OR B>90 THEN 7090
  148. 7100  PRINT D$;
  149. 7110  C$=INKEY$:IF C$=""THEN 7110 ELSE IF C$=CHR$(27) THEN 7299 ELSE IC=ASC(C$):IF IC=8 THEN LOCATE 4,29:PRINT" ";:LOCATE 4,29:GOTO 7090 ELSE IF IC<123 AND IC>96 THEN IC=IC-32:C$=CHR$(IC) ELSE IF IC<65 OR IC>90 THEN 7110
  150. 7120  PRINT C$;:AT=0:CO$=A$+D$+C$+" "
  151. 7125  AT=AT+1:IF AT>MN THEN A=0:GOTO 7150 ELSE IF CONS$(AT)=CO$ THEN 7160 ELSE GOTO 7125
  152. 7150  KXY=1:GOTO 7001
  153. 7160  GOSUB 30000:SB=1:LC=2:N=AC(AT)-1
  154. 7170  N=N+1:GET#1,N:IB=CVS(B$):IF BINS(IB)=0 THEN 7170 ELSE IF CON$<>CO$ THEN 7245 ELSE GM=VAL(MAG$):IF GM>TOPM THEN 7170 ELSE RA=VAL(RA1$)+VAL(RA2$)/60+VAL(RA3$)/3600:DEC=VAL(D1$)+VAL(D2$)/60+VAL(D3$)/3600:IF SD$="-"THEN DEC=-DEC
  155. 7180  M=INT(GM+0.5):IF IPROP=1 THEN RA=RA+(VAL(PMR$)*YDI)/54000:DEC=DEC+(VAL(PMD$)*YDI)/3600
  156. 7210  ON IPREC GOSUB 19900,20000:IF Z=0 OR Y<2 OR Y>196 THEN 7170
  157. 7212  IF M=4 THEN KX=INT(X-0.5):KY=INT(Y-0.5):PUT(KX,KY),M4%,PSET:GOTO 7170
  158. 7214  IF M=3 THEN KX=INT(X-1):KY=INT(Y-1):PUT(KX,KY),M3%,PSET:GOTO 7170
  159. 7216  KX=INT(X-2):KY=INT(Y-2):IF M=2 THEN PUT(KX,KY),M2%,PSET:GOTO 7170
  160. 7218  IF M=1 THEN PUT(KX,KY),M1%,PSET:GOTO 7170
  161. 7220  IF M<=0 THEN PUT(KX,KY),M0%,PSET:GOTO 7170
  162. 7245  LOCATE 1,1:DEF SEG:POKE &H4E,IC1:LOCATE 1,1:PRINT WHCON$(AT):MESS=1:A$=INKEY$:GOTO 5000
  163. 7299  GOSUB 30000:GOTO 5000
  164. 8000  IF IDONE=0 THEN ICR=1:GOSUB 6000 ELSE IF MESS=1 THEN CLS:GOSUB 30000
  165. 8010  A$=INKEY$:DEF SEG:POKE &H4E,3:X=IXP:Y=IYP:IF IAU+IAD=0 THEN PUT(X,Y),P%,XOR:GOTO 8020 ELSE IF IAU=1 THEN PUT(X+2,Y+5),U%,XOR :GOTO 8020 ELSE IF IAD=1 THEN PUT(X+2,Y),D%,XOR:GOTO 8020
  166. 8016  IXP=X:IYP=Y:DRAW"bm 150,108 c=ic1;r16 f2 d16 g2 l16 h2 u16 e2 bm -3,-1 l12 g2 d19 f2 r17 h1r17 f1 l16  BM +19,-23 R14 F2 D19 G2 L14 E2 U 19 H2":LOCATE 15,20:PRINT"Num":LOCATE 16,20:PRINT"Lock":LOCATE 12,15:PRINT"Please press:"
  167. 8017  A$=INKEY$:IF A$="" THEN 8017 ELSE IF A$<>"8" AND A$<>"4" AND A$<>"2" AND A$<>"6" THEN GOSUB 30000:GOTO 8000 ELSE GOTO 8017
  168. 8020  A$=INKEY$:IF A$=""THEN 8020
  169. 8022  IF LEN(A$)=1 THEN 8040 ELSE AB$=RIGHT$(A$,1):XO=X:YO=Y
  170. 8030  IF AB$=CHR$(72)THEN Y=Y-1:GOTO 8085 ELSE IF AB$=CHR$(75)THEN X=X-1:GOTO 8080 ELSE IF AB$=CHR$(77)THEN X=X+1:GOTO 8080:ELSE IF AB$=CHR$(80)THEN Y=Y+1:GOTO 8085 ELSE GOTO 8020
  171. 8040  IF A$=CHR$(13) THEN 8200
  172. 8050  IF A$=CHR$(27)THEN 4080 ELSE IF A$="8" OR A$="4" OR A$="6" OR A$="2" THEN 8016
  173. 8070  GOTO 8020
  174. 8080  XX=X-XCC:X2=XX*XX:XPY=X2+Y2:IF XPY>RR2 THEN X=XO:X2=XX*XX:GOTO 8020 ELSE GOTO 8090
  175. 8085  YY=YCC-Y:Y2=YY*YY:XPY=X2+Y2:IF XPY>RR2 THEN Y=YO:Y2=YY*YY:GOTO 8020
  176. 8090  IF IAU+IAD=0 THEN PUT(XO,YO),P%,XOR:IF Y<190 AND Y>-1 THEN PUT(X,Y),P%,XOR:GOTO 8020 ELSE IF Y=190 THEN IAD=1:PUT(X+2,Y),D%,XOR:GOTO 8020 ELSE IF Y<0 THEN IAU=1:PUT(X+2,Y+5),U%,XOR:GOTO 8020
  177. 8095  IF IAU=1 THEN IF Y<-5 THEN X=XO:Y=YO:GOTO 8020 ELSE PUT(XO+2,YO+5),U%,XOR:IF Y<0 AND Y>-6 THEN PUT(X+2,Y+5),U%,XOR:GOTO 8020 ELSE IF Y=0 THEN PUT(X,Y),P%,XOR:IAU=0:GOTO 8020
  178. 8100  IF Y>193 THEN X=XO:Y=YO:GOTO 8020 ELSE PUT (XO+2,YO),D%,XOR:IF Y=189 THEN PUT(X,Y),P%,XOR:IAD=0:GOTO 8020 ELSE PUT (X+2,Y),D%,XOR:GOTO 8020
  179. 8200  LOCATE 1,1:PRINT"Please wait...":IXP=X:IYP=Y:XO=X+5.5:YO=Y+5.5:DISS=100:LJ1=YO*ULY+17:LJ2=(LJ1+5)\8:LJ1=LJ1\8
  180. 8210  FOR JJ=LJ1 TO LJ2:IF ACT(JJ,0)=0 THEN 8275 ELSE FOR NJ=1 TO ACT(JJ,0):K=ACT(JJ,NJ):IF K>=0 THEN GET#1,K ELSE RA=PL(-K-1,0):DEC=PL(-K-1,1):GOSUB 20000:GOTO 8237
  181. 8220  RA=VAL(RA1$)+VAL(RA2$)/60+VAL(RA3$)/3600:DEC=VAL(D1$)+VAL(D2$)/60+VAL(D3$)/3600:IF SD$="-"THEN DEC=-DEC
  182. 8230  IF IPROP=1 THEN RA=RA+(VAL(PMR$)*YDI)/54000:DEC=DEC+(VAL(PMD$)*YDI)/3600
  183. 8235  ON IPREC GOSUB 19900,20000
  184. 8237  DIS=ABS(XO-X)+ABS(YO-Y):IF DIS<DISS THEN DISS=DIS:IND=K
  185. 8270  NEXT NJ
  186. 8275  NEXT JJ
  187. 8350  IF DISS<=3 THEN 8355 ELSE LINE (58,48)-(264,108),0,BF:POKE &H4E,3:LOCATE 8,9:PRINT"No object has been found.":LOCATE 9,9:PRINT"Check page 20 of your":LOCATE 10,9:PRINT"P.C. PLANETARIUM booklet":LOCATE 11,9:PRINT"for help.
  188. 8352  LOCATE 13,9:PRINT"Press I to try again.":LINE(58,48)-(264,108),IC2,B,&HAAAA:IR=1:MESS=1:GOTO 5000
  189. 8355  IF IND>=0 THEN GET#1,IND ELSE IN=-IND-1:RA=PL(IN,0):DEC=PL(IN,1):GOSUB 20000:GOTO 8371
  190. 8360  RA=VAL(RA1$)+VAL(RA2$)/60+VAL(RA3$)/3600:DEC=VAL(D1$)+VAL(D2$)/60+VAL(D3$)/3600:IF SD$="-"THEN DEC=-DEC
  191. 8365  IF IPROP=1 THEN RA=RA+(VAL(PMR$)*YDI)/54000:DEC=DEC+(VAL(PMD$)*YDI)/3600
  192. 8370  ON IPREC GOSUB 19900,20000
  193. 8371  LOCATE 1,1:PRINT STRING$(14,32):IF IAU=1 THEN PUT(XO-3.5,YO-0.5),U%,XOR ELSE IF IAD=1 THEN PUT(XO-3.5,YO-5.5),D%,XOR:ELSE PUT(XO-5.5,YO-5.5),P%,XOR
  194. 8372  X=INT(X):Y=INT(Y):CIRCLE(X,Y),5,IC1:POKE &H4E,IC1:IS=1:IR=0:IF X<160 THEN IR=1:IS=31:IF CON$="    "THEN IS=29
  195. 8375  IF IND<0 THEN IF X<160 THEN IS=33:GOTO 8500 ELSE GOTO 8500 ELSE IF CON$="    "THEN LOCATE 1,IS:ID=2:PRINT"This star is":IF IR=1 THEN IS=28:GOTO 8413 ELSE GOTO 8413
  196. 8376  OPEN "conames"FOR INPUT AS #3:IS=1:IR=0:IF X<160 THEN IR=1:IS=31
  197. 8377  INPUT#3,NA$:INPUT#3,NB$:IF NA$+" "<>CON$ THEN 8377 ELSE CLOSE#3
  198. 8380  LOCATE 1,IS:PRINT"This star":N=15:IF LEFT$(POP$,1)=" "THEN ID=3:IF IR=1 THEN LOCATE 2,32:PRINT"is in the":IS=28:GOTO 8409 ELSE PRINT"is in the":GOTO 8409
  199. 8389  P$=POP$
  200. 8390  N=N-1:IF RIGHT$(P$,1)=" "THEN P$=LEFT$(P$,N):GOTO 8390:ELSE IF IR=1 THEN IS=36-N
  201. 8400  LOCATE 2,IS:ID=3:PRINT "is "P$",
  202. 8405  IF IR=1 THEN IS=35
  203. 8407  LOCATE ID,IS:ID=ID+1:PRINT"in the":IF IR=1 THEN IS=28
  204. 8409  LOCATE ID,IS:ID=ID+1:PRINT"constellation":IF IR=1 THEN IS=40-LEN(NB$)
  205. 8411  LOCATE ID,IS:ID=ID+1:PRINT NB$",":IF IR=1 THEN IS=28
  206. 8413  LOCATE ID,IS:ID=ID+1:PRINT"catalogued as":IF SS$="  " THEN SS$=" " ELSE IF LEFT$(SS$,1)<>" "THEN SS$=" "+SS$
  207. 8414  IF LEFT$(HR$,1)=" " THEN HR$=RIGHT$(HR$,3)
  208. 8415  NAM$=HR$+FL$+" "+GK$(VAL(GR$))+SS$+LEFT$(CON$,3)
  209. 8416  L=LEN(NAM$):IF RIGHT$(NAM$,1)=" " THEN NAM$=LEFT$(NAM$,L-1):GOTO 8416 ELSE IF IR=1 THEN IS=37-LEN(NAM$)
  210. 8417  LOCATE ID,IS:ID=ID+1:PRINT"HR "NAM$".":IF IR=1 THEN IS=31-LEN(MAG$)
  211. 8418  LOCATE ID,IS:ID=ID+1:PRINT"Magnitude="MAG$:IF IR=1 THEN IS=24
  212. 8419  RA=(RI+RAO)/HF:TN=SD:TD=CD:GOSUB 16300:DEC=T/RF:GOSUB 20300:LOCATE ID,IS:PRINT"r.a.="RA$:ID=ID+1:IF IR=1 THEN IS=26:IF IND<0 AND IN<>7 THEN IS=28
  213. 8421  LOCATE ID,IS:PRINT"dec.="I1;:JX=LEN(STR$(I1))+4:JY=8*ID-8:JX=8*(IS+JX)-1
  214. 8422  PUT(JX,JY),DG%:PRINT DC2$" ";:JX=LEN(DC2$):JX=8*JX+11:DRAW"BM+=jx;,+0 c=ic1;d2 R1 U2":PRINT DC3$:ID=ID+1
  215. 8423  H=RAO-RA*HF:SH=SIN(H):CH=COS(H):SL=SIN(FLAT*RF):CL=COS(FLAT*RF):IF CD=0 THEN TDEC=SGN(SD)*1.7E+38 ELSE TDEC=SD/CD
  216. 8424  DEN=CH*SL-TDEC*CL:XAZ=0:IF DEN<0 THEN XAZ=PI# ELSE IF DEN=0 THEN XAZ=SGN(SH)*PI#/2:GOTO 8430
  217. 8428  XAZ=XAZ+ATN(SH/DEN)
  218. 8430  V=XAZ/RF
  219. 8432  GOSUB 20400:LOCATE ID,IS:PRINT"azm.="V1$ V2$;:IF IND>=0 OR IND=-8 THEN PRINT V3$ CHR$(34);
  220. 8435  JX=LEN(V1$):JX=8*(IS+JX+4)-1:JY=8*ID-8:PUT(JX,JY),DG%:JX=LEN(V2$):JX=8*JX+3:DRAW"bm+=jx;,+0 d2 r1 u2":ID=ID+1:IF IR=1 THEN IS=IS-1
  221. 8440  SALT=SL*SD+CL*CD*CH:CALT=SQR(1-SALT*SALT):XALT=0:IF CALT<0 THEN XALT=PI# ELSE IF CALT=0 THEN XALT=SGN(SALT)*PI#/2:GOTO 8450
  222. 8445  XALT=XALT+ATN(SALT/CALT)
  223. 8450  V=XALT/RF:IF IND<0 AND IND<>-8 THEN V=V+0.00833
  224. 8452  GOSUB 20400:LOCATE ID,IS:PRINT"alt.="V1$ V2$;:IF IND>=0 OR IND=-8 THEN PRINT V3$ CHR$(34); ELSE PRINT" ";
  225. 8455  PRINT ".":JX=LEN(V1$)+4:JX=8*(IS+JX)-1:JY=8*ID-8:PUT(JX,JY),DG%:JX=LEN(V2$):JX=8*JX+3:DRAW"bm+=jx;,+0 d2 r1 u2":ID=ID+1
  226. 8490  MESS=1:GOTO 5000
  227. 8500  LOCATE 1,IS:ID=3:PRINT"This is":IF IR=1 THEN IS=39-LEN(PL$(IN))
  228. 8510  LOCATE 2,IS:PRINT PL$(IN)".":IF IN<>7 THEN RA=RA+0.00833:DEC=DEC+0.00833:GOSUB 20300:RA$=LEFT$(RA$,8):DC3$=""ELSE GOSUB 20300
  229. 8515  IF IR=1 THEN IF IN<>7 THEN IS=27 ELSE IS=24
  230. 8520  GOTO 8419
  231. 9000  A$=INKEY$:IF A$<>""THEN 9000
  232. 9001  IF IWH=6 THEN ICR=1:GOSUB 6440
  233. 9004  SCREEN 0,1:CLS:COLOR IBR:IF ERR=25 OR ERR=57 OR ERR=24 OR ERR=68 THEN LOCATE 5,5:PRINT"There is some error":LOCATE 7,5:PRINT"with your hardware.":LOCATE 9,5:PRINT"Please check your equipment.":GOTO 9500
  234. 9010  CLS:COLOR IBR
  235. 9020  IF ERR<>71 AND ERR<>53 THEN 9030 ELSE LOCATE 5,5:PRINT"There is some trouble with the":LOCATE 6,5:PRINT"diskette.  Please be sure that":LOCATE 7,5:PRINT"the P.C. Planetarium diskette":LOCATE 8,5:PRINT"is in your diskette drive and
  236. 9025  LOCATE 9,5:PRINT"that the diskette drive door":LOCATE 10,5:PRINT"is closed.":GOTO 9500
  237. 9030  IF ERR=9 OR ERR=11 OR ERR=5 OR ERR=10 THEN RESUME NEXT
  238. 9035  LOCATE 5,5:PRINT"There is some error.  The":LOCATE 7,5:PRINT"program will go back a step":LOCATE 9,5:PRINT"and you can try again.":GOTO 9500
  239. 9500  LOCATE 20,5:PRINT"Press";:COLOR IBW:PRINT" ENTER";:COLOR IBR:PRINT" when you are ready."
  240. 9505  FOR I=0 TO 10:K$(I)="":NEXT I:KI=0:KL=-1
  241. 9510  A$=INKEY$:IF A$="" THEN 9510 ELSE IF A$<>CHR$(13) THEN 9510 ELSE IF IWH=0 THEN GOSUB 30010:RESUME 4990 ELSE IF IWH=6 THEN GOSUB 30000:IDONE=0:RESUME ELSE IF IWH=3012 THEN ICR=1:GOSUB 30230:ICR=0:RESUME
  242. 9520  CLS:SCREEN 1:LOCATE 1,1:PRINT"Please wait":RESUME
  243. 15000  '
  244. 15010  SLAM=SIN(XLAM):TN=SLAM*CEO-TAN(XB)*SEO:TD=COS(XLAM):RA=0:IF TD<0 THEN RA=PI# ELSE IF TD=0 THEN RA=SGN(TN)*PI#/2:GOTO 15030
  245. 15020  RA=RA+ATN(TN/TD)
  246. 15030  RA=RA/HF:SDEC=SIN(XB)*CEO+COS(XB)*SEO*SLAM:CDEC=SQR(1-SDEC*SDEC):DEC=0:IF CDEC<0 THEN DEC=PI# ELSE IF CDEC=0 THEN DEC=SGN(SDEC)*PI#/2:GOTO 15050
  247. 15040  DEC=DEC+ATN(SDEC/CDEC)
  248. 15050  DEC=DEC/RF:RETURN
  249. 16250  TD=SQR(1-TN*TN)
  250. 16300  T=0:IF TD<0 THEN T=PI# ELSE IF TD=0 THEN T=SGN(TN)*PID2#:RETURN
  251. 16310  T=T+ATN(TN/TD):RETURN
  252. 16400  IF ABS(P)>32760 THEN P=P-SGN(P)*32760:GOTO 16400
  253. 16405  P=P-360*(P\360-1)
  254. 16410  LP=INT(P):P=P-LP+LP MOD 360:RETURN
  255. 16990  E0=P:P2=E0:EAB=10
  256. 16995  EAD2=EAB:EAD=(P2+EP*SIN(E0)-E0)/(1-EP*COS(E0)):E0=E0+EAD:EAB=ABS(EAD):IF EAB<9.99998E-12 THEN RETURN ELSE IF EAB>=EAD2 THEN RETURN:ELSE GOTO 16995
  257. 19900  RI=RA*HF+CE:CD=COS(RF*DEC):CRI=COS(RI)*CD:SD=SIN(RF*DEC):TA=CD*SIN(RI):TB=CTE*CRI-STE*SD:SD=STE*CRI+CTE*SD:CD=SQR(1-SD*SD):IF SD>0.95 THEN CD=TA*TA+TB*TB:SD=SQR(1-CD):CD=SQR(CD)
  258. 19904  IF DEC=90 THEN DEC=89.999 ELSE IF DEC=-90 THEN DEC=-89.999
  259. 19906  RAZ=0:IF TB<0 THEN RAZ=PI# ELSE IF TB=0 THEN RAZ=SGN(TA)*PI#/2:GOTO 19920
  260. 19910  RAZ=ATN(TA/TB)+RAZ:IF RAZ<0 THEN RAZ=RAZ+2*PI#
  261. 19920  RAZ=RAZ+ZE:RI=RAZ-RAO:IF IMORE=0 THEN 20020 ELSE SR=SIN(RAZ):CR=COS(RAZ):TN=SD:TD=CD:GOSUB 16300:DEC=T/RF
  262. 19925  IF INUT=1 THEN TDEC=TAN(T):RI=RI+(CEO+SEO*SR*TDEC)*DPHER-CR*TDEC*DEPR:DEC=DEC+SEO*CR*DPHED+SR*DEPD
  263. 19930  IF IABER=1 THEN RI=RI-(CR*CSLEDR*CEO+SR*SSLEDR)/CD:DEC=DEC-(CSLEDD*CEO*(TEO*CD-SR*SD)+CR*SD*SSLEDD)
  264. 19950  DC=DEC*RF:GOTO 20010
  265. 20000  RI=RA*HF-RAO:DC=DEC*RF
  266. 20010  SD=SIN(DC):CD=COS(DC):IF ABS(SD)<EE THEN SD=0 ELSE IF ABS(CD)<EE THEN CD=0
  267. 20020  CR=COS(RI):IF ABS(CR)<EE THEN CR=0
  268. 20030  Z=SD*SDO+CR*CD*CDO
  269. 20040  IF Z<EE THEN Z=0:RETURN
  270. 20050  SR=SIN(RI):IF ABS(SR)<EE THEN SR=0
  271. 20070  DEN=Z+DOR:Y=YC-(DPP*(SD*CDO-SDO*CR*CD))/DEN
  272. 20080  X=-(DPX*CD*SR)/DEN+XC:RETURN
  273. 20200  MI=0:A=LEN(XX$)-1:IF LEFT$(XX$,1)="-"THEN MI=1:XX$=RIGHT$(XX$,A)
  274. 20210  A=A-5:XX=VAL(LEFT$(XX$,2))+(VAL(MID$(XX$,4,2)))/60+(VAL(RIGHT$(XX$,A)))/3600:IF MI=1 THEN XX=-XX:XX$="-"+XX$
  275. 20220  RETURN
  276. 20300  I1=INT(RA):RW=(RA-I1)*60+EE:I2=INT(RW):RW=(RW-I2)*60:I3=INT(RW+0.5):RA$=RIGHT$(STR$(I1),2)+"h."+RIGHT$(STR$(I2),2)+"m."+RIGHT$(STR$(I3),2)+"s."
  277. 20310  D=ABS(DEC):I1=INT(D):RW=(D-I1)*60+EE:I2=INT(RW):RW=(RW-I2)*60:I3=INT(RW+0.5):DC2$=RIGHT$(STR$(I2),2):DC3$=RIGHT$(STR$(I3),2)+CHR$(34):IF DEC<0 THEN I1=-I1:RETURN ELSE RETURN
  278. 20400  I1=INT(V):V2=(V-I1)*60:I2=INT(V2):I3=INT((V2-I2)*60+0.5):V1$=RIGHT$(STR$(I1),3):V2$=" "+LEFT$(STR$(I2),2):V3$=" "+LEFT$(STR$(I3),2):RETURN
  279. 29999  DEF SEG:POKE &H4E,IC2:LOCATE 1,34:PRINT"North":LOCATE 5,36:PRINT"West":DRAW"c=ic2;bm 273,14 e3 f3 h3 d22 u6 l6 r22 g3 e3 h3":RETURN
  280. 30000  IF IESC=1 THEN 30010 ELSE IF ICR=1 THEN ICR=0:RETURN ELSE IF IDONE=0 THEN ICR=1:GOSUB 6000
  281. 30010  CLS:SCREEN 1,0:PUT(48,49),P1%:PUT(60,21),P2%:PUT(80,0),P3%:PUT(240,21),P4%:PUT(260,49),P5%:RETURN
  282. 30150  ON ERROR GOTO 9000:DEFDBL C-E,H,P-T,X-Z:DEFINT A-B,I-N:KEY OFF:SCREEN 1,0:KEY 9,"screen 0,1"+CHR$(13):KEY 10,"width 80"+CHR$(13):IDONE=0:JD#=FJD#:UL=60/72:TOPM=4.499:IPROP=0:IPREC=2:IABER=0:INUT=0:DPX=DPP:SCR=1:IXP=170:IYP=90:KL=-1
  283. 30156  IC1=1:IC2=2:IGR=2:IBW=15:IYL=14:IBR=6:ILR=12:IRD=4:IF FO=1 THEN IGR=7:IYL=15:IYL=15:IBR=15:ILR=15:IRD=15:IC1=3:IC2=3:RESTORE 30158
  284. 30157  CLS:LOCATE 1,5:COLOR 0,1:DEF SEG:POKE &H4E,IC1:PRINT"Your Sky Map is being prepared.":FOR N=0 TO 6:READ DG%(N):NEXT N:DATA 12,5,16389,20500,20500,16389,0 :DATA 12,5,-16369,-4036,-4036,-16369,0:RESTORE 30159
  285. 30158  DATA 12,5,-16369,-4036,-4036,-16369,0
  286. 30159  FOR N=0 TO 7:READ PL$(N):NEXT N:DATA the moon,Mercury,Venus,the sun,Mars,Jupiter,Saturn,Halley's Comet
  287. 30160  DIM SU%(18),S1%(12),S4%(12),S2%(12),S5%(12),S6%(12),H%(12):FOR N=0 TO 12:READ S1%(N),S2%(N),S4%(N),S5%(N),S6%(N),H%(N):NEXT N:FOR N=0 TO 18:READ SU%(N):NEXT N
  288. 30175  DATA 16,16,16,16,16,16,10,10,10,10,10,6,0,0,-4096,0,252,16128,-16192,0,-4096,-16324,48,-16324,63,63,63,-16189,63,-29,-16192,-16192,-16192,-16381,-16336,195,-16184,-16184,-16184,-16376,-16328,60,-16192,-16192,-16192,-16336,51,0
  289. 30176  DATA  63,63,63,-3841,60,0,12,12,0,-16384,60,0,63,63,0,0,51,0,12,12,0,0,0,0,0,0,0,0,0,0
  290. 30180  DATA  22,11,12288,12288,12336,12300,960,51,-1024,-256,-769,-1024,768,51,12300,12480,12336,12288,0
  291. 30182  FOR N=0 TO 6:READ N0%(N),N1%(N),N2%(N),N3%(N),N4%(N):NEXT N:DATA 10,10,10,10,10,5,5,5,5,5,0,0,0,0,0,51,12,12,60,48,12,51,63,60,0,51,12,12,0,0,0,0,0,0,0
  292. 30184  FOR N=0 TO 6:READ R0%(N),R1%(N),R2%(N),R3%(N),R4%(N),M0%(N),M1%(N),M2%(N),M3%(N),M4%(N):NEXT N:GOTO 1030
  293. 30185  DATA 10,10,10,10,10,10,10,10,10,10,5,5,5,5,5,5,5,5,5,5,63,63,63,60,48,63,63,63,60,48,-16158,-16184,-16184,235,236,-16175,-16188,-16188,215,220,-16184,-16158,-16150,235,48,-16188,-16175,-16171,215,48,-16158,-16184,-16184
  294. 30190  DATA 60,0,-16175,-16188,-16188,60,0,63,63,63,0,0,63,63,63,0,0
  295. 30200  DIM LLS(14),BINS(217),ACT(58,32),AC(75),CONS$(75),WHCON$(75),P%(18),P1%(304),P2%(784),P3%(8004),P4%(784),P5%(304),U%(8),D%(8),ILX(15),GK$(24),OP$(12),OPP$(12),OB$(13),OBB$(13)
  296. 30205  FOR N=0 TO 12:READ OP$(N):READ OPP$(N):NEXT N:DATA "No ",0804,"No ",0904,"No ",1004,"No ",1104,"4.5", 1734,0,1911,1,1912,0,1914,1,1915,7,2011,2,2012,6,2014,0,2015
  297. 30206  FOR N=0 TO 13:OB$(N)=CHR$(176):READ OBB$(N):NEXT N:DATA 0812,0813,0818,0819,0824,0825,1412,1413,1414,1418,1419,1423,1424,2112
  298. 30210  FOR N=1 TO 24:READ GK$(N):NEXT N:DATA alpha,beta,gamma,delta,epsilon,zeta,eta,theta,iota,kappa,lambda,mu,nu,xi,omicron,pi,rho,sigma,tau,upsilon,phi,chi,psi,omega
  299. 30220  FOR N=0 TO 14:READ ILX(N):NEXT N:DATA 128,64,32,16,8,4,2,1,16384,8192,4096,2048,1024,512,256:IF FO=1 THEN RESTORE 30252
  300. 30230  FOR N=0 TO 8:READ U%(N):NEXT N:DATA 14,7,2,-32758,8226,2178,2,2,2
  301. 30240  FOR N=0 TO 8:READ D%(N):NEXT N:DATA 14,6,2,2,2178,8226,-32758,2,0
  302. 30250  FOR N=0 TO 18:READ P%(N):NEXT N:DATA 22,11,8192,0,32,8192,0,32,8192,-22016,-22358,8192,0,32,8192,0,32,8192,0
  303. 30252  DATA 14,7,3,-16369,12339,3267,3,3,3,14,6,3,3,3267,12339,-16369,3,0
  304. 30255  DATA 22,11,12288,0,48,12288,0,48,12288,-256,-769,12288,0,48,12288,0,48,12288,0
  305. 30260  PI#=3.14159:EE=9.99E-07:HF=PI#/12:RF=PI#/180:PI2#=PI#+PI#:PID2#=PI#/2:TJ#=(JD#-2.41502E+06)/36525:P=279.697+(36000.8+0.0003025*TJ#)*TJ#:GOSUB 16400:SML=P
  306. 30270  P=TJ#*(TJ#*(TJ#*(-3.3E-06)-0.00015)+35999)+358.476:GOSUB 16400:SMA=P*RF
  307. 30280  EEO=TJ#*(TJ#*(-1.26E-07)-4.18E-05)+0.016751:SMA2=SMA+SMA:P=SIN(SMA)*(TJ#*(TJ#*(-1.4E-05)-0.004789)+1.91946)+SIN(SMA2)*(0.020094-0.0001*TJ#)+SIN(SMA+SMA2)*0.000293:GOSUB 16400:SEC=P
  308. 30290  P=SEC+SML:GOSUB 16400:SLED=P:SRV=1*(1-EEO*EEO)/(1+EEO*COS(SEC*RF+SMA))
  309. 30300  P=259.18-1934.14*TJ#:GOSUB 16400:XOM=P*RF
  310. 30310  P=SLED-0.00569-0.00479*SIN(XOM):GOSUB 16400:STL=P:P=RF*P:SSTL=SIN(P):CSTL=COS(P):STA=SMA+SEC:P=TJ#*(TJ#*(TJ#*5.03E-07-1.64E-06)-0.0130125)+23.4523:GOSUB 16400:EO=P:P=EO*RF:CEO=COS(P):SEO=SIN(P):SLED=RF*SLED:TEO=SEO/CEO
  311. 30320  EOC=RF*(EO+0.00256*COS(XOM)):SSLEDD=20.49*SIN(SLED)/3600:CSLEDD=20.49*COS(SLED)/3600:SSLEDR=SSLEDD*RF:CSLEDR=CSLEDD*RF
  312. 30330  TN=COS(EOC)*SSTL:TD=CSTL:GOSUB 16300:SUNRA=T/HF:IF SUNRA<0 THEN SUNRA=SUNRA+24
  313. 30340  TN=SIN(EOC)*SSTL:GOSUB 16250:SUNDEC=T/RF
  314. 30360  XC=161:YC=100:XCC=XC-5.5:YCC=YC-5.5:R=85:D=200:P=60:DPP=D+P:DOR=D/R:DDPP=D*DPP:DPP2=DPP*DPP:D2X=D*D:R2=R*R:R2M=R2-D2:RR2=R2*DPP2/D2X
  315. 30370  RESTORE 30370:FOR N=0 TO 14:READ LLS(N):NEXT N:DATA 90,82,58,47,38,24,12,0,-12,-24,-38,-47,-58,-82,-90
  316. 30380  DEC=FLAT:DECK=FLAT:DECO=RF*FLAT:RAO=FSD#*HF-FLON*RF:SDO=SIN(DECO):CDO=COS(DECO):YDI=FTAU*100:IF RAO<0 THEN RAO=RAO+PI2# ELSE IF RAO>PI2# THEN RAO=RAO-PI2#
  317. 30390  CE=((0.018*FTAU+0.302)*FTAU+2305.65)*FTAU*RF/3600:TE=((-0.042*FTAU-0.426)*FTAU+2003.83)*FTAU*RF/3600:CTE=COS(TE):STE=SIN(TE):ZE=((0.019*FTAU+1.093)*FTAU+2305.65)*FTAU*RF/3600:GOSUB 30770
  318. 30400  RA=RAO/HF:RAK=RA
  319. 30420  GOSUB 30640:LK=L:L=LK+1
  320. 30430  L=L-1:IF L=0 THEN RA=RAK:DEC=82.01:GOSUB 20000:IF Z=0 THEN 30450 ELSE BINS(0)=1:GOTO 30450
  321. 30440  DEC=LLS(L+1)+0.01:GOSUB 30490:GOTO 30430
  322. 30450  L=LK:IF LK=13 THEN L=12
  323. 30460  L=L+1:IF L=13 THEN RA=RAK:DEC=-82.01:GOSUB 20000:IF Z=0 THEN ERASE LLS:GOTO 30765 ELSE BINS(217)=1:ERASE LLS:GOTO 30765
  324. 30470  DEC=LLS(L)-0.1
  325. 30480  GOSUB 30490:GOTO 30460
  326. 30490  LERS=1:IF ABS(DEC)>38 THEN LERS=2
  327. 30500  RK=LERS*INT(RAK/LERS):RA1=RK:RA2=RK:RE=RK+12:IF RE>=24 THEN RE=RE-24
  328. 30510  RA=RK:GOSUB 20000:IF Z>0 THEN GOSUB 30640:BINS(IB)=1 ELSE RETURN
  329. 30520  RA=RA2+4*LERS:IF RA>23.99 THEN RA=RA-24
  330. 30530  GOSUB 20000:IF Z=0 THEN 30600
  331. 30540  RA22=RA:GOSUB 30640:BINS(IB)=1:IR3=0:FOR N=1 TO 3:RA=RA2+N*LERS:IF RA>=24 THEN RA=RA-24
  332. 30550  GOSUB 30640:BINS(IB)=1:RA=RA1-N*LERS:IF RA<0 THEN RA=RA+24
  333. 30560  IF RA=RE THEN IR3=1
  334. 30562  GOSUB 30640:BINS(IB)=1:NEXT N:IF IR3=1 THEN RETURN ELSE RA=RA-LERS:IF RA<0 THEN RA=RA+24
  335. 30565  IF RA=RE THEN RETURN ELSE GOSUB 30640:BINS(IB)=1:RA1=RA:RA2=RA22:GOTO 30520
  336. 30570  RA=RA1+LERS-0.01:IF RA>=24 THEN RA=RA-24
  337. 30580  GOSUB 20000:GOSUB 30640:IF Z=0 THEN BINS(IB)=0:RETURN ELSE BINS(IB)=1:RA=RA-LERS:IF RA<0 THEN RA=RA+24
  338. 30590  GOTO 30580
  339. 30600  RA=RA2+LERS:IF RA>=24 THEN RA=RA-24
  340. 30610  GOSUB 20000:IF Z=0 THEN 30570
  341. 30620  GOSUB 30640:BINS(IB)=1:RA2=RA:RA=RA1-LERS:IF RA<0 THEN RA=RA+24
  342. 30630  GOSUB 30640:BINS(IB)=1:RA1=RA:GOTO 30600
  343. 30640  RI=INT(RA):IF DEC<0 THEN 30710
  344. 30650  IF DEC<36 THEN B=INT(DEC/12):IB=85-24*B+RI:L=6-B:RETURN
  345. 30660  IF DEC<38 THEN IB=37+RI:L=4:RETURN
  346. 30670  IF DEC>=82 THEN IB=0:L=0:RETURN
  347. 30680  IF DEC<47 THEN IB=25+INT(RI/2):L=3:RETURN
  348. 30690  IF DEC<58 THEN IB=13+INT(RI/2):L=2:RETURN
  349. 30700  IF DEC<82 THEN IB=1+INT(RI/2):L=1:RETURN
  350. 30710  IF DEC>-36 THEN B=INT(DEC/12)+1:IB=109-24*B+RI:L=7-B:RETURN
  351. 30720  IF DEC>-38 THEN IB=157+RI:L=9:RETURN
  352. 30730  IF DEC>-47 THEN IB=181+INT(RI/2):L=10:RETURN
  353. 30740  IF DEC>-58 THEN IB=193+INT(RI/2):L=11:RETURN
  354. 30750  IF DEC>-82 THEN IB=205+INT(RI/2):L=12:RETURN
  355. 30760  IB=217:L=13:RETURN
  356. 30765  IWH=307:OPEN"stars"AS #1 LEN=72
  357. 30766  FIELD#1,4 AS B$,5 AS MAG$,4 AS HR$,3 AS FL$,2 AS GR$,2 AS SS$,4 AS CON$,2 AS RA1$,2 AS RA2$,4 AS RA3$,1 AS SD$,2 AS D1$,2 AS D2$,2 AS D3$,6 AS PMR$, 6 AS PMD$,6 AS PAR$,15 AS POP$
  358. 30768  IDOP=1:CHAIN MERGE"planmerg",4000,ALL,DELETE 30150-40000
  359. 30770  P=TJ#*(TJ#*(TJ#*2.2E-06+0.002078)-1934.14)+259.183:GOSUB 16400:TOM=P:'moon
  360. 30780  SOM=SIN(RF*TOM):STERM=SIN(RF*(51.2+20.2*TJ#)):STERM2=0.003964*SIN(RF*(TJ#*(TJ#*(-0.0091731)+132.87)+346.56))
  361. 30790  P=TJ#*(TJ#*(TJ#*1.9E-06-0.001133)+481268)+270.434:GOSUB 16400:TLPU=P:TLP=TLPU+0.000233*STERM+STERM2+0.001964*SOM
  362. 30810  TM=(SMA/RF-0.001778*STERM)*RF
  363. 30820  P=TJ#*(TJ#*(TJ#*1.44E-05+0.009192)+477199)+296.105:GOSUB 16400:TMPU=P:TMP=RF*(TMPU+0.000817*STERM+STERM2+0.002541*SOM)
  364. 30840  P=TJ#*(TJ#*(TJ#*1.9E-06-0.001436)+445267)+350.737+0.002011*STERM+STERM2+0.001964*SOM:GOSUB 16400:TD=P*RF
  365. 30850  P=TJ#*(TJ#*(TJ#*(-3E-07)-0.003211)+483202)+11.2509+STERM2-0.004328*SIN(RF*(TOM+275.05-2.3*TJ#))-0.024691*SOM:GOSUB 16400:TF=P*RF
  366. 30860  ET=TJ#*(TJ#*(-7.52E-06)-0.002495)+1:ET2=ET*ET:TM2=TM+TM:TMP2=TMP+TMP:TD2=TD+TD:TF2=TF+TF:TMP3=TMP+TMP2:TF3=TF2+TF:TD4=TD2+TD2:TMP4=TMP2+TMP2:TD3=TD+TD2
  367. 30870  TLAM=TLP+6.28875*SIN(TMP)+1.27402*SIN(TD2-TMP)+0.658309*SIN(TD2)+0.213616*SIN(TMP2)-ET*0.185596*SIN(TM)-0.114336*SIN(TF2)+0.058793*SIN(TD2-TMP2)+ET*0.057212*SIN(TD2-TM-TMP)+0.05332*SIN(TD2+TMP)
  368. 30880  TLAM=TLAM+ET*0.045874*SIN(TD2-TM)+ET*0.041024*SIN(TMP-TM)-0.034718*SIN(TD)-ET*0.030465*SIN(TM+TMP)+0.015326*SIN(TD2-TF2)-0.012528*SIN(TF2+TMP)-0.01098*SIN(TF2-TMP)+0.010674*SIN(TD4-TMP)+0.010034*SIN(TMP3)+0.008548*SIN(TD4-TMP2)
  369. 30890  TLAM=TLAM-ET*0.00791*SIN(TM-TMP+TD2)-ET*0.006783*SIN(TD2+TM)+0.005162*SIN(TMP-TD)+ET*0.005*SIN(TM+TD)+ET*0.004049*SIN(TMP-TM+TD2)+0.003996*SIN(TMP2+TD2)+0.003862*SIN(TD4)+0.003665*SIN(TD2-TMP3)+ET*0.002695*SIN(TMP2-TM)
  370. 30900  TLAM=TLAM+0.002602*SIN(TMP-TF2-TD2)+ET*0.002396*SIN(TD2-TM-TMP2)-0.002349*SIN(TMP+TD)+ET2*0.002249*SIN(TD2-TM2)-ET*0.002125*SIN(TMP2+TM)-ET2*0.002079*SIN(TM2)+ET2*0.002059*SIN(TD2-TMP-TM2)-0.001773*SIN(TMP+TD2-TF2)-0.001595*SIN(TF2+TD2)
  371. 30910  TLAM=TLAM+ET*0.00122*SIN(TD4-TM-TMP)-0.00111*SIN(TMP2+TF2)+0.000892*SIN(TMP-TD3)-ET*0.000811*SIN(TM+TMP+TD2)+ET*0.000761*SIN(TD4-TM-TMP2)+ET2*0.000717*SIN(TMP-TM2)+ET2*0.000704*SIN(TMP-TM2-TD2)+ET*0.000693*SIN(TM-TMP2+TD2)
  372. 30920  TLAM=TLAM+ET*0.000598*SIN(TD2-TM-TF2)+0.00055*SIN(TMP+TD4)+0.000538*SIN(TMP4)+ET*0.000521*SIN(TD4-TM)+0.000486*SIN(TMP2-TD)
  373. 30930  TB=5.12819*SIN(TF)+0.280606*SIN(TMP+TF)+0.277693*SIN(TMP-TF)+0.173238*SIN(TD2-TF)+0.055413*SIN(TD2+TF-TMP)+0.046272*SIN(TD2-TF-TMP)+0.032573*SIN(TD2+TF)+0.017198*SIN(TMP2+TF)+0.009267*SIN(TD2+TMP-TF)
  374. 30940  TB=TB+0.008823*SIN(TMP2-TF)+ET*0.008247*SIN(TD2-TM-TF)+0.004323*SIN(TD2-TF-TMP2)+0.0042*SIN(TD2+TF+TMP)+ET*0.003372*SIN(TF-TM-TD2)+ET*0.002472*SIN(TD2+TF-TM-TMP)+ET*0.002222*SIN(TD2+TF-TM)+ET*0.002072*SIN(TD2-TF-TM-TMP)+ET*0.001877*SIN(TF-TM+TMP)
  375. 30950  TB=TB+0.001828*SIN(TD4-TF-TMP)-ET*0.001803*SIN(TF+TM)-0.00175*SIN(TF3)+ET*0.00157*SIN(TMP-TM-TF)-0.001487*SIN(TF+TD)-ET*0.001481*SIN(TF+TM+TMP)+ET*0.001417*SIN(TF-TM-TMP)+ET*0.00135*SIN(TF-TM)
  376. 30960  TB=TB+0.00133*SIN(TF-TD)+0.001106*SIN(TF+TMP3)+0.00102*SIN(TD4-TF)+0.000833*SIN(TF+TD4-TMP)+0.000781*SIN(TMP-TF3)+0.00067*SIN(TF+TD4-TMP2)+0.000606*SIN(TD2-TF3)+0.000597*SIN(TD2+TMP2-TF)
  377. 30970  TB=TB+ET*0.000492*SIN(TD2+TMP-TM-TF)+0.00045*SIN(TMP2-TF-TD2)+0.000439*SIN(TMP3-TF)+0.000423*SIN(TF+TD2+TMP2)+0.000422*SIN(TD2-TF-TMP3)-ET*0.000367*SIN(TM+TF+TD2-TMP)-ET*0.000353*SIN(TM+TF+TD2)+0.000331*SIN(TF+TD4)
  378. 30980  TB=TB+ET*0.000317*SIN(TD2+TF-TM+TMP)+ET2*0.000306*SIN(TD2-TM2-TF)-0.000283*SIN(TMP+TF3):TB=TB*(1-0.0004664*COS(RF*TOM)-7.54E-05*COS(RF*(TOM+275.05-2.3*TJ#))):XLAM=TLAM*RF:XB=TB*RF:GOSUB 15000:RAMO=RA:DECMO=DEC
  379. 31001  SML=SML*RF:TLPU=TLPU*RF:TMPU=TMPU*RF
  380. 31010  TOM=TOM*RF:TLPU2=TLPU+TLPU:SML2=SML+SML:DPHE=-(17.2327+0.01737*TJ#)*SOM-(1.2729+0.00013*TJ#)*SIN(SML2)+0.2088*SIN(2*TOM)-0.2037*SIN(TLPU2)+(0.1261-0.00031*TJ#)*SIN(SMA)+0.0675*SIN(TMPU)-(0.0497-0.00012*TJ#)*SIN(SML2+SMA)
  381. 31020  DPHE=DPHE-0.0342*SIN(TLPU2-TOM)-0.0261*SIN(TLPU2+TMPU)+0.0214*SIN(SML2-SMA)-0.0149*SIN(SML2-TLPU2+TMPU)+0.0124*SIN(SML2-TOM)+0.0114*SIN(TLPU2-TMPU)
  382. 31030  DEP=(9.21+0.00091*TJ#)*COS(TOM)+(0.5522-0.000289999*TJ#)*COS(SML2)-0.0904*COS(2*TOM)+0.0884*COS(TLPU2)+0.0216*COS(SML2+SMA)+0.0183*COS(TLPU2-TOM)+0.0113*COS(TLPU2+TMP)
  383. 31040  DEP=DEP-0.0093*COS(SML2-SMA)-0.0066*COS(SML2-TOM):DPHED=DPHE/3600:DEPD=DEP/3600:DPHER=DPHED*RF:DEPR=DEPD*RF:RETURN
  384. 40000  '
  385.